Hyper Stacks 1994 May/Hyper Stacks (Pacific HiTech)(1994)[Mac].iso/XCMDS&XFCNS/Support Tools eXternals 1.2.5/Support Tools eXternals 1.2.5/card_12806.txt

Text File | 1990-11-14 | 9.2 KB | 293 lines

-- card: 12806 from stack: in.5
-- bmap block id: 16987
-- flags: 0000
-- background id: 3858
-- name: System Path
----- HyperTalk script -----
on HideObjects
  hide cd btn "try it!"
end HideObjects

on ShowObjects
  show cd btn "try it!"
end ShowObjects


-- part 1 (button)
-- low flags: 00
-- high flags: A002
-- rect: left=82 top=185 right=219 bottom=175
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 8192
-- line height: 16
-- part name: Try it!
----- HyperTalk script -----
on mouseUp
  global errGlobal
  answer "The path to your system folder is “" & SystemPath("noDialog:errGlobal") & "”."
end mouseUp




-- part contents for background part 38
----- text -----
45/50

-- part contents for background part 42
----- text -----
{ SystemPath(“noDialog:”errorGlobal)          }
{ XFCN to return the path to the currently active system folder}
{}
{}
{  brought to you by:  Anup Murarka      Eric Carlson    }
{            ALINK:  SKEPTIC      ALINK:  cyNic  }
{                  CIS:  76004,3356    }
{}
{        We are part of the Support Tools Development Group,  }
{        Apple Computer, Inc.  }
{}
{        please DO NOT contack Mac DTS for support of this code!  }
{}
{        please DO contact the authors for support of this code!  }
{}
{        Send comments, bug reports, requests to any of the above  }
{        E-mail addresses or to:}
{}
{              (one of us)          }
{              Apple Computer, Inc.    }
{              900 E. Hamilton, Ave.    }
{              Campbell, CA   95008    }
{              M/S 72-L          }
{}
{  Copyright:  © 1989, 1990 by Apple Computer, Inc., all rights reserved.  }
{}
{ written by Eric Carlson                    }
{ AppleLink:  cyNic                        }
{ modification history                                             }
{       Date        Initials                  Comments                }
{       ----        ------    ------------------------------------------------------}
{    3/8/90        ec      first written                                }
{    6/2/90        ec      modified for A/UX 2.0 compatibility  (recompiled with new     }
{                                  library routines)                          }
{}

unit SystemPath;

interface

  uses
    HyperXCmd;

  procedure MAIN (paramPtr: XCmdPtr);

implementation

  procedure reportToUser (paramPtr: XCmdPtr;
                  msgStr: str255);
{}
{ report something back to the user.  }
{ the last parameter (optional) to an external may contain }
 { "noDialog" or "noDialog:GlobalName".  GlobalName is the name }
 { of a HyperTalk global variable into which error messages will be }
 { placed.  we've decided to use this approach to avoid confusing }
{ an error message with a valid result being returned from an XFCN. }
{}
    var
      tempStr: str255;
  begin
{check the last param to see if the user requested that}
{ we suppress the error dialog }
    ZeroToPas(paramPtr, paramPtr^.params[paramPtr^.paramCount]^, tempStr);
    UprString(tempStr, true);
    if pos('NODIALOG', tempStr) = 0 then
  { no special error handling specified, throw up a dialog and return the error message }
      begin
        SendCardMessage(paramPtr, concat('answer "', msgStr, '"'));
        paramPtr^.returnValue := PasToZero(paramPtr, msgStr);
      end
    else if (pos(':', tempStr) > 0) then
  { requested global AND noDialog so we fill in the global and return empty }
      begin
        tempStr := copy(tempStr, pos(':', tempStr) + 1, length(tempStr));
                            { get the name of the HC global  to fill }
        SetGlobal(paramPtr, tempStr, PasToZero(paramPtr, msgStr));
                            { and fill it }
        paramPtr^.returnValue := PasToZero(paramPtr, '');  { return empty }
      end
    else
  { requested noDialog only so we return the error condition as the result }
      paramPtr^.returnValue := PasToZero(paramPtr, msgStr);
  end;  { procedure }

  function askedForHelp (paramPtr: XCmdPtr;
                  syntaxMsg: Str255;
                  copyRightMsg: Str255): boolean;
{  check to see if the user sent a '?' or a '!' as }
{ the only parameter. if so we will respond with }
{ the calling syntax or the copyright/version info }
{ for this external }
{}
    var
      firstStr: str255;
  begin
    askedForHelp := false;
    if paramPtr^.paramCount = 1 then
      begin
        ZeroToPas(paramPtr, paramPtr^.params[1]^, firstStr);
          { what is the first param? }
        if firstStr = '?' then
          begin
            reportToUser(paramPtr, syntaxMsg);
            askedForHelp := true
          end  { asked for help }
        else if firstStr = '!' then
          begin
            reportToUser(paramPtr, copyRightMsg);
            askedForHelp := true
          end;  { asked for copyright info }
      end;  { one parameter passed }
  end;  { function }

  function NumberToString (paramPtr: XCmdPtr;
                  num: LONGINT): Str255;
{ use the toolbox call rather than HC's }
    var
      tempStr: str255;
  begin
    NumToString(num, tempStr);
    NumberToString := tempStr;
  end;

  procedure ReportVolError (paramPtr: XCmdPtr;
                  errorNum: integer);
    var
      errMsg, tempName: str255;
  begin
    sysbeep(40);
    case errorNum of          { what caused the problem? }
      bdNamErr:
        errMsg := 'Bad volume name.';
      extFSErr:
        errMsg := 'External file system.';
      ioErr:
        errMsg := 'I/O Error.';
      nsDrvErr:
        errMsg := 'No such drive.';
      nsvErr:
        errMsg := 'No such volume.';
      paramErr:
        errMsg := 'No default volume.';
      otherwise
        errMsg := concat('unexpected error #', NumberToString(paramPtr, errorNum));
    end;    { case }

    errMsg := concat('Sorry, ', errMsg);
    reportToUser(paramPtr, errMsg);
    { return the error message }
  end;    { function }

  function PathNameFromDirID (dirID: longint;
                  vRefnum: integer;
                  var fullPathName: str255): OSErr;
{ build up a full path name given a directory id and an vol ref num.  this method isn't reccomended in general (see the }
{  various tech notes, but we use it in HC externals as HC uses exclusively full path names }
    var
      myCPB: CInfoPBRec;
      directoryName: str255;
      err: OSErr;
  begin
    fullPathName := '';
    with myCPB do
      begin
        ioNamePtr := @directoryName;
        ioDrParID := DirId;
      end;

    repeat
      with myCPB do
        begin
          ioVRefNum := vRefNum;
          ioFDirIndex := -1;
          ioDrDirID := myCPB.ioDrParID;
        end;
      err := PBGetCatInfo(@myCPB, FALSE);

      directoryName := concat(directoryName, ':');

{ pascal strings mustn't be longer than 255 chars, though a path name may, so check }
      if length(directoryName) + length(fullPathName) <= 255 then
        fullPathName := concat(directoryName, fullPathName)
      else
        myCPB.ioDrDirID := fsRtDirID;    { lazy persons way to jump out }

    until (myCPB.ioDrDirID = 2);
    PathNameFromDirID := err;
  end;

  procedure SystemPath (paramPtr: XCmdPtr);
    var
      pathName: str255;
      PB: HParamBlockRec;
      errorCode: OSerr;
      sysRec: SysEnvRec;
      systemVRefNum: longint;

  begin  { SystemPath}
    if AskedForHelp(paramPtr, 'SystemPath(“noDialog:”errorGlobal)', '© 1989, 1990 by Apple Computer, Inc., v.1.1,  by Eric Carlson.') then
      exit(SystemPath);


    errorCode := SysEnvirons(2, sysRec);        { Get the vrefnum of the directory containing the open System file }
    if errorCode <> noErr then              { we will use this in our PBHGetVInfo }
      begin
        ReportToUser(paramPtr, 'Unexpected SysEnvirons error.');
        exit(SystemPath);
      end;
    systemVRefNum := sysRec.sysVRefNum;



    zeroBytes(paramPtr, @PB, sizeOf(PB));      { initialize the parameter block with zeros in all fields.}
    with PB do                        { now fill in the paramBlock for our call }
      begin
        ioCompletion := nil;                  { don't need an async call }
        ioNamePtr := nil;                  { don't know the volume's name, nor do we care }
        ioVolIndex := 1;                    { we want info on the first mounted volume - the boot volume }
      end;

    errorCode := PBHGetVInfo(@PB, false);        { next we need the directory id of the blessed folder - one of those  }
    if errorCode <> noErr then              {  mysterious “Finder Flag” fields on the in the param block}
      begin
        ReportVolError(paramPtr, errorCode);
        exit(SystemPath);
      end;

    errorCode := PathNameFromDirID(PB.ioVFndrInfo[1], systemVRefNum, pathName);  { and now the full path }
    if errorCode <> noErr then
      begin
        ReportVolError(paramPtr, errorCode);
        exit(SystemPath);
      end;

    paramPtr^.returnValue := PasToZero(paramPtr, pathName);
  end;

  procedure MAIN (paramPtr: XCmdPtr);
  begin
    SystemPath(paramPtr);
  end;

end.

-- part contents for background part 20
----- text -----
     Returns the path to the currently active System folder.  Useful if you need to find or leave a preferences file, or whatever.


     Calling Syntax: SystemPath(“noDialog:”errorGlobal)